
 ;         T O W E R S   O F   H A N O I


 ( define row 0 )
 ( define dsk 0 )
 ( define col 0 )
 ( define n 0 )
 ( define base"###############################################################################" )
 ( define stick "|" )
 ( define disk ( make-vector 13 ) )
 ( define stack-1 ( make-vector 13 ) )
 ( define stack-2 ( make-vector 13 ) )
 ( define stack-3 ( make-vector 13 ) )
 ( define tos ( make-vector 4 ) )
 ( define left-col ( make-vector 4 ) )


 ; | This routine clears the screen. |

 ( define CLS
   ( lambda ( )
     ( set-video-mode! 3 )
    )
  )


 ; | This routine places the cursor at |
 ; | specified position on the screen. |

 ( define GOTOXY
   ( lambda ( x y )
     ( window-set-cursor! 'console x y )
     ( display "" )
    )
  )


 ; | This routine creates a delay depending |
 ; | on the number passed to it.            |

 ( define CREATE-DELAY
   ( lambda ( delay-no )
     ( if ( > delay-no 0 )
       ( CREATE-DELAY ( - delay-no 1 ) )
      )
    )
  )


 ; | This routine displays the |
 ; | title of the program.     |

 ( define DISPLAY-TITLE
   ( lambda ( )
     ( CLS )
     ( GOTOXY 1 10 )
     ( display "Towers of Hanoi" )
    )
  )


 ; | This routine initializes different |
 ; | vectors used in the program.       |

 ( define INITIALIZE
   ( lambda ( )
     ( vector-set! tos 1 n )
     ( vector-set! tos 2 0 )
     ( vector-set! tos 3 0 )

     ( vector-set! left-col 1  1 )
     ( vector-set! left-col 2 27 )
     ( vector-set! left-col 3 53 )

     ( do
       ( ( i n ( - i 1 ) ) )
       ( ( = i 0 ) ( display "" ) )
       ( vector-set! stack-1 i ( + ( - n i ) 1 ) )
      )
    )
  )


 ; | This routine initializes the 'disk' |
 ; | vector to disks of various sizes.   |

 ( define DISK-DEF
   ( lambda ( )
     ( vector-set! disk  1 "           ===           " )
     ( vector-set! disk  2 "          =====          " )
     ( vector-set! disk  3 "         =======         " )
     ( vector-set! disk  4 "        =========        " )
     ( vector-set! disk  5 "       ===========       " )
     ( vector-set! disk  6 "      =============      " )
     ( vector-set! disk  7 "     ===============     " )
     ( vector-set! disk  8 "    =================    " )
     ( vector-set! disk  9 "   ===================   " )
     ( vector-set! disk 10 "  =====================  " )
     ( vector-set! disk 11 " ======================= " )
     ( vector-set! disk 12 "=========================" )
    )
  )


 ; | This routine places a stick at the |
 ; | specified position on the screen.  |

 ( define PUT-STICK
   ( lambda ( row col )
     ( GOTOXY row col )
     ( display stick )
    )
  )


 ; | This routine places three |
 ; | poles on the screen.      |

 ( define DISPLAY-POLE
   ( lambda ( )
     ( do
       ( ( r 22 ( - r 1 ) ) )
       ( ( = r 9 ) ( display "" ) )
       ( PUT-STICK r 13 )
       ( PUT-STICK r 39 )
       ( PUT-STICK r 65 )
      )
    )
  )


 ; | This routine places specified number |
 ; | of disks on the first pole.          |

 ( define PUT-DISKS
   ( lambda ( num )
     ( do
       ( ( r 22 ( - r 1 ) ) )
       ( ( = num 0 ) ( display "" ) )
       ( GOTOXY r 1 )
       ( display ( vector-ref disk num ) )
       ( set! num ( - num 1 ) )
      )
    )
  )


 ; | This routine displays initial screen. |

 ( define SCREEN-SETUP
   ( lambda ( )
     ( GOTOXY 23 0 )
     ( display base )
     ( DISPLAY-POLE )
     ( PUT-DISKS n )
    )
  )


 ; | This routine returns the disk number |
 ; | on the top of the specified pole.    |

 ( define RETURN-DISK
  ( lambda ( org )
    ( cond
      ( ( = org 1 ) ( set! dsk ( vector-ref stack-1 ( vector-ref tos org ) ) ) )
      ( ( = org 2 ) ( set! dsk ( vector-ref stack-2 ( vector-ref tos org ) ) ) )
      ( ( = org 3 ) ( set! dsk ( vector-ref stack-3 ( vector-ref tos org ) ) ) )
     )
   )
  )


 ; | This routine lifts the disk from |
 ; | the top of the specified pole.   |

 ( define LIFT-DISK
   ( lambda ( org )
     ( RETURN-DISK org )
     ( do
       ( ( r ( - 23 ( vector-ref tos org ) ) ( - r 1 ) ) )
       ( ( = r 8 ) ( display "" ) )
       ( GOTOXY r ( vector-ref left-col org ) )
       ( if ( > r 9 )
          ( display "            |            " )
         ( display "                         " )
        )
       ( GOTOXY ( - r 1 ) ( vector-ref left-col org ) )
       ( display ( vector-ref disk dsk ) )
       ( CREATE-DELAY 500 )
      )
     ( vector-set! tos org ( - ( vector-ref tos org ) 1 ) )
    )
  )


 ; | This routine places the disk on |
 ; | the top of the specified pole.  |

 ( define LAND-DISK
   ( lambda ( dest )
     ( do
       ( ( r 8 ( + r 1 ) ) )
       ( ( = r ( - 22 ( vector-ref tos dest ) ) ) ( display "" ) )
       ( GOTOXY r ( vector-ref left-col dest ) )
       ( if ( > r 9 )
          ( display "            |            " )
         ( display "                         " )
        )
       ( GOTOXY ( + r 1 ) ( vector-ref left-col dest ) )
       ( display ( vector-ref disk dsk ) )
       ( CREATE-DELAY 500 )
      )
     ( vector-set! tos dest ( + ( vector-ref tos dest ) 1 ) )
     ( cond
       ( ( = dest 1 ) ( vector-set! stack-1 ( vector-ref tos 1 ) dsk ) )
       ( ( = dest 2 ) ( vector-set! stack-2 ( vector-ref tos 2 ) dsk ) )
       ( ( = dest 3 ) ( vector-set! stack-3 ( vector-ref tos 3 ) dsk ) )
      )
    )
  )


 ; | This routine scrolls the disk from the origin |
 ; | to the destination in the right direction.    |

 ( define RIGHT-SCROLL
   ( lambda ( org dest )
     ( do
       ( ( col ( vector-ref left-col org ) ( + col 1 ) ) )
       ( ( = col ( - ( vector-ref left-col dest ) 1 ) ) ( display "" ) )
       ( GOTOXY 8 col )
       ( display "                         " )
       ( GOTOXY 8 ( + col 1 ) )
       ( display ( vector-ref disk dsk ) )
       ( CREATE-DELAY 250 )
      )
    )
  )


 ; | This routine scrolls the disk from the origin |
 ; | to the destination in the Left direction.     |

 ( define LEFT-SCROLL
   ( lambda ( org dest )
     ( do
       ( ( col ( vector-ref left-col org ) ( - col 1 ) ) )
       ( ( = col ( vector-ref left-col dest ) ) ( display "" ) )
       ( GOTOXY 8 col )
       ( display "                         " )
       ( GOTOXY 8 ( - col 1 ) )
       ( display ( vector-ref disk dsk ) )
       ( CREATE-DELAY 500 )
      )
    )
  )


 ; | This routine is the main routine which decides upon which |
 ; | disk to move and from where to where.                     |
 ; | Recursive algorithm :-                                    |
 ; |                                                           |
 ; | 1. Move ( N - 1 ) disks from 'Origin' to 'Temporary' pole |
 ; |    using 'Destination' for intermediate use.              |
 ; | 2. Move the remaining n th disk to the 'Destination'      |
 ; | 3. Move ( N - 1 ) disks from 'Temporary' to 'Destination' |
 ; |    pole using 'Origin' for intermediate use.              |
 ; |                                                           |
 ; |    Where 'N' is the number of disks.                      |

 ( define TRANSFER-DISK
   ( lambda ( num org dest temp )
     ( if  ( > num 0 )
       ( begin
         ( TRANSFER-DISK ( - num 1 ) org temp dest )
         ( MOVE-DISK org dest )
         ( TRANSFER-DISK ( - num 1 ) temp dest org )
        )
      )
    )
  )


 ; | This routine moves the disk i.e. it 'Lifts', |
 ; | 'Left/Right scrolls' and 'Lands' the disk.   |

 ( define MOVE-DISK
   ( lambda ( org dest )
     ( LIFT-DISK org )
     ( if ( < org dest )
        ( RIGHT-SCROLL org dest )
       ( LEFT-SCROLL org dest )
      )
     ( LAND-DISK dest )
    )
  )


 ; | This routine inputs the number of disks. |

 ( define INPUT-DISKS
   ( lambda ( )
     ( define c 0 )
     ( GOTOXY 10 24 )
     ( display " Select Number Of Disks :    " )
     ( set! n 1 )
     ( GOTOXY 11 51 )
     ( display n )
     ( display " " )
     ( GOTOXY 1 10 )
     ( do
       ( )
       ( ( = c 13 ) ( GOTOXY 10 24 )
                    ( display "                               " )
                    ( GOTOXY 11 24 )
                    ( display "                               " )
                    ( GOTOXY 12 24 )
                    ( display "                               " )
        )
       ( begin
         ( set! c ( char->integer ( read-char ) ) )
         ( if ( = c 0 )
           ( begin
             ( case ( char->integer ( read-char ) )
               ( ( 72 ) ( if ( < n 12 )
                           ( set! n ( + n 1 ) )
                          ( set! n 1 )
                         )
                )
               ( ( 80 ) ( if ( > n 1 )
                           ( set! n  ( - n 1 ) )
                          ( set! n 12 )
                         )
                )
              )
             ( GOTOXY 11 51 )
             ( display n )
             ( display " " )
             ( GOTOXY 1 10 )
            )
          )
        )
      )
    )
  )


 ; | This routine calls the other routines.  |
 ; | Type '(hanoi)' to execute this program, |
 ; | once this program has been loaded.      |

 ( alias H HANOI )
 ( alias HAN HANOI )
 ( define HANOI
   ( lambda ( )
     ( DISPLAY-TITLE )
     ( INPUT-DISKS )
     ( INITIALIZE )
     ( DISK-DEF )
     ( SCREEN-SETUP )
     ( CREATE-DELAY 10000 )
     ( TRANSFER-DISK n 1 3 2 )
     ( GOTOXY 24 0 )
     ( read-char )
     ( display "" )
    )
  )


 ( HANOI )    ; Run the program.
